perm filename CLOSE.1[AID,LSP]1  blob 
sn#559612 filedate 1981-01-26 generic text, type C, neo UTF8
 
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 Helps close files that are randomly open
C00005 ENDMK
C⊗;
;;; Helps close files that are randomly open
(declare (fasload util fas dsk (aid rpg)))
(macrodef real-tyi ()
 (while (member (tyipeek) '(13. 10.)) do (tyi)) (tyi))
(declare (special close-file-start-address))
(setq close-file-start-address (getddtsym 'chntb))
;(cond ((status features onesegment)
;       (cond ((status features paging)
;	      (setq close-file-start-address 149.))
;	     (t (setq close-file-start-address 190.))))
;      (t (cond ((status features ddt) (setq close-file-start-address 6846.))
;	       (t (setq close-file-start-address 190.)))))
(defun closer ()
 (let file ← nil 
      end ← (+ close-file-start-address 17.)
      lm ← (status linmode) do
      (sstatus linmode nil)
      (do ((i close-file-start-address (1+ i)))
	  ((= i end) t)
	  (setq file (munkam (examine i)))
	  (and file
	       (not (member 'tty (car (status filemode file))))
	       (progn (terpri)
		      (princ file)
		      (princ '| - Close this one? |)
		      (member (real-tyi) '(89. 121.)))
	       (progn (close file) (terpri) (princ file) (princ '| closed!|))))
      (sstatus linmode lm)
      (terpri)
      'done))   
(defun closeall ()
 (let file ← nil 
      end ← (+ close-file-start-address 17.)
      do
      (do ((i close-file-start-address (1+ i)))
	  ((= i end) t)
	  (setq file (munkam (examine i)))
	  (and file
	       (not (member 'tty (car (status filemode file))))
	       (progn (close file) (terpri) (princ file) (princ '| closed!|))))
      (terpri)
      'done))